perm filename TEMP[S1,ALS] blob sn#483569 filedate 1979-10-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Recent corrections to SOPU as of Oct. 17 1979
C00011 ENDMK
C⊗;
Recent corrections to SOPU as of Oct. 17 1979

    OLDMAXTMPS1REG :  S1REGISTER;  				(*pn*)
    PSWITCHNAME,MOSTCOMPLEXPROC,CHKNAME: alfa;  			(*pn*)
    BOUND :  integer;		(* pn *)

	    WRITELN(OUTPUT,'Not yet implemented')    (*pn*)

procedure PRINTSCONST(var STRVAL :  STRINGTYPE; var STRLGTH :  STRINX);
   (*Print a string from STRVAL as a quoted string constant -- PN *)

6 FINDRGBLOCK FIXES
    IN COERCE_DATUM
    (*pn 27sep79...*)  if RTYPE = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[RTYPE] then FINDRP else FINDRG;
    IN LOADSTACKEXCEPT
    (*pn 27sep79...*)  if DTYPE = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
    IN VPA_FPA_FINALIND
    (*pn 27sep79...*)  if DTYPE = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
    IN SHORT_AND_REG
    (*pn 27sep79...*)  if DTYPE = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
    IN DEREF_TO_END
    (*pn 27sep79...*)  if STK[STE].DTYPE = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
    IN UDUP :                       (* als/peg 02jul79 *)
    (*pn 27sep79...*)  if TYP = TYPUS then
			    FINDRGBLOCK(S1SETREP_SIZE)
    (*...pn 27sep79*)  else if IS_DOUBLE[TYP] then FINDRP else FINDRG;

" (* older version used -- pn *)
  procedure UPD_BOUNDTBL (var DISP :  S1DISP; LOW, HI :  integer;

(*	    if DTYPE in [TYPUJ,TYPUL,TYPUB,TYPUC] then  *) (*pn*)
  	    if DTYPE in [TYPUJ,TYPUL,TYPUB,TYPUC,TYPQ] then  

3 SIMPLIFY FIXES
  IN	 procedure COMPARE_SETS;                     (*peg 03jul79...*)
	UDIF
	USGS, UINN :			(* als/peg 05jul79 *)

            with STK[TOP] do
              if (NVPAS = 1) and (VPA1.VPAIND = IND2) and (VPA1.VPA.WHICH = MEM) then
                 SIMPLIFY(TOP); (*pn*)
            with STK[TOP-1] do
              if (NVPAS = 1) and (VPA1.VPAIND = IND2) and (VPA1.VPA.WHICH = MEM) then
                 SIMPLIFY(TOP-1); (*pn*)

INDIRECTION FIX IN UEQU .
        if (TYP <> TYPUM) then    (*pn*)
	  for STE := TOP-1 to TOP do
	    with STK[STE] do
		begin
		INC_INDIRECTION(STE, IND1);
		DTYPE := TYP;
		DLENGTH := I1;
		end (*with STK[STE] do*);

IN 2 PLACES
	IMM_OPERAND (OPND2, I1 div CHARBITS);       (* pn *)

IN ULDA :
	DLENGTH := WORDUNITS;   (*pn*)

IN USTR, UNSTR :		(* als/peg 03jul79 *)
    if TYP = TYPUE then  (*pn*)
        begin
        TYP := TYPUJ;
        I3 := 36;
	end;

(*	OPND.XW.DISP := -I1;    *)  (*pn*)
	OPND1.XW.DISP := I1;

IN UEND :			(* als/peg 05jul79 *)
    if MAXTMPS1REG > OLDMAXTMPS1REG then   (*pn*)
        begin
	OLDMAXTMPS1REG := MAXTMPS1REG;
        MOSTCOMPLEXPROC := NAM1.NAM;
        end;

    (* pn: TYPUB added (index checking for ARRAY[boolean]) *)
      [TYPUA, TYPUB, TYPUC, TYPUI, TYPUJ, TYPUK, TYPUL, TYPUN, TYPUS]) then

        (* the following assignments to DLENGTH ARE necessary *)
        else if (TYPO2 = TYPUB) then  (*pn*)
		begin   
		if BREPRES=BJUMP then BJUMP_TO_BINTVAL (TOP);
		DLENGTH := QWBITS;
		end

IN UDUP :			(* als/peg 02jul79 *)
        if TYP in [TYPUJ,TYPUL] then COERCE_INT_DATUM (TOP);  (*PN*)
IN UIXA :			(* als/peg 29Jun79 *)
(*  if TYP in [TYPUJ, TYPUL] then  *)  (*pn*)
    if STK[TOP].DTYPE in [TYPUJ, TYPUL] then  
	COERCE_INT_DATUM(TOP);
IN UPAR :
    IF STK[TOP].DTYPE = TYPUM then  (*pn*)
        COERCE_DATUM (TOP, TYPUA);

             (*	    S1OP := XMOV_S_S;  *)
		    S1OP := MOV_X_X[TYP];  (* pn *)

IN UCUP, UICUP: 			(*peg 09aug79*)
    while PARM <= PRMTOP do   (*pn...*)
	begin (*check reg. parms for correct order, collect excess*)
	if IS_DOUBLE[STK[PARM].DTYPE] then
	    PARMWORDSIZE := 2
	else PARMWORDSIZE := 1;
	if (PWORDCOUNT + PARMWORDSIZE > MAXPAREG) then
		EXCESS := EXCESS + PARMWORDSIZE
	else
	    begin (*reg. parm*)
	    LASTREGPARM := PARM;
	    PREG := MINPARS1REG + PWORDCOUNT;
	    if not (DAT_IS_REG(PARM)
	      and (STK[PARM].VPA1.VPA.RGADR = PREG)) then
		ASSERTFAIL('UCUP     001');
	    end (*reg. parm*);
        PWORDCOUNT := PWORDCOUNT + PARMWORDSIZE;
	PARM := PARM + 1;
	end (*check reg. parms*);   (*...pn*)

IN  procedure READSET(var S :  SETREP);
	(*Read a set as a string of octal digits and convert it to a SETREP,
	    returning it in S.  PDP-10 version. *)
        (* pn 19SEP79 *)
	var J, N :  integer;
	    CH : char;
	begin
	while (INPUT↑=' ') do get (INPUT);
	S := NULL_SET;					
	N := 0;
	while N < SET_SIZE do 
          begin
          read (INPUT, CH);
          J := ORD (CH) - ORD ('0');
          if J > 3 then BUILD_SET(S,N);
          if (J mod 4) > 1 then BUILD_SET(S,N+1);
          if odd(J) then BUILD_SET(S,N+2);
  	  N := N + 3;
 	  end
	end (*READSET*);
    
IN	UCOMM :
		begin   (* pn *)
		while (CH = ' ') and not eoln(INPUT) do READ(CH);
		CLEN := 0;
		while not eoln(INPUT) and (CLEN < COMMLEN) do
		    begin
		    CLEN := CLEN + 1;
		    READ(CH); COMMFIELD[CLEN] := CH;
		    end;
		end (*UCOMM*);

IN procedure INITIALIZE;
        OLDMAXTMPS1REG := MAXTMPS1REG;  (*pn*)

IN  MAIN_PROGRAM:			**)
WRITELN(OUTPUT);						(* pn *)